perm filename CMDEMO.MF[TYP,TEX] blob
sn#723016 filedate 1983-08-04 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00016 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 mode = proof
C00004 00003 "Computer Modern Roman 10 point"
C00006 00004 % From file CMBASE.MF[MF,SYS]
C00053 00005 % From file AMR10.MF[MF,SYS]
C00054 00006 % From file ROMAN[MF,SYS]
C00058 00007 % From file ROMANU[MF,SYS]
C00060 00008 % From file ROMANU[MF,SYS]
C00064 00009 % From file ROMANU[MF,SYS]
C00068 00010 % From file ROMANU[MF,SYS]
C00072 00011
C00074 00012
C00077 00013
C00080 00014
C00084 00015
C00089 00016 % From file AMR10.MF[MF,SYS]
C00090 ENDMK
C⊗;
mode = proof;
%-------------------------------------------------------------------
% Rescale the image so it will fit in a 12 pica square.
oldsize = 8; % The character was originally this many picas tall.
newsize = 12.1; % So it will be this many picas tall, we must
blowup = newsize/oldsize; % rescale it by this factor.
mag = blowup;
"Computer Modern Roman 10 point";
fontidentifier "CMR"; ptsize=10;
pww=7/36; % small hairline width
puw=11/36; % uppercase hairline width
pscorr=1/36; % some stems to be this much thinner
pbow=1/36; % baseline serifs to be bowed by this much
phcorr=1/36; % some hairlines to be this much thicker
pdot=38/36; % dots
pws=11/36; % thickness of serifs and arms
pwu=11/36; % thickness of uppercase bars (A and H)
pwb=11/36; % thickness of uppercase bowl bars
uc=0; % correction to unit measurements on certain characters
usc=-.25; % uppercase serif correction
sqdot=0; % dots to be round
theta=1/6; % affects super-ness inside bowls
aspw=8/36; % hairline height
prt=.4; % rule thickness for math symbols
mathspread=0; % proportion of spreading for symbols like =
psmid=27.5/36; % thickness of stroke in middle of "s"
ph=250/36; px=155/36; pe=87/36; pd=70/36;
pb=20/36; po=8/36; ps=20/36; pas=70/36; pa=.5(ph-pd);
pw=9/36; pwi=25/36; pwii=30/36; pwiii=33/36;
pwiv=32/36; pwv=37/36; pdel=0; fudge=1.0;
pu=20/36; lcs=1.4; ucs=1.85; sc=0; ls=0;
slant=0; sqrttwo=sqrt 2; fixwidth=0; crisp=1;
phh=ph-pssd; phhh=ph-18/36; pssd=.5po; pdd=pd; varg=0; lowast=0; ligs=1.
% From file CMBASE.MF[MF,SYS]
eps=.000314159; % a very small random positive number
circlemode;
proof=0; lowres=1; crs=2; dover=3; canon=5; smoke=6; % symbolic names of modes
designsize ptsize; % ignore error messages you get with old MF!
if mode<0: mmode=-mode; new mode; mode=mmode; % negative modes assume \\{mag} is set
else: new mag; mag=1;
fi;
stephalf=sqrt(1.2); stepi=1.2; stepii=1.44; stepiii=1.728;
stepiv=2.0736; stepv=2.48832;
magnification mag;
if mode=proof: proofmode; drawdisplay; titletrace;
pixels=36*mag; blacker=0; overcorr=1; % for initial design of characters
else: if mode=lowres: fntmode; tfxmode; no modtrace;
pixels=(200/72.27)mag; blacker=.65; overcorr=.4; % XGP, etc.
else: if mode=crs: crsmode; tfxmode; titletrace; no modtrace;
pixels=(16000/(3*72.27))mag; blacker=4; overcorr=1; % Alphatype
else: if mode=dover: ocmode; tfmmode; dotwdmode; no modtrace;
overcorr=.6;
pixels=(384/72.27)mag; blacker=1.2; % Xerox Dover
else: if mode=canon: rstmode; tfxmode; no modtrace;
pixels=(240/72.27)mag; % Canon LBP10
blacker=.2; overcorr=.4;
else: if mode=smoke: proofmode; titletrace; no points;
no modtrace;
pixels=72;
blacker=0; overcorr=1;
else: input mode;
fi; fi;
fi;
fi;
fi;
fi;
%fontfacebyte 254-2*ptsize; % that was used for old cm fonts
fontfacebyte 154-2*ptsize; % new convention for am fonts!
if ptsize>77: fontfacebyte 252;
fi;
hresolution pixels; vresolution pixels.
subroutine fontbegin: % Initialize before making a font:
no eqtrace; % Turn off tracing within this subroutine
new typesize; % the vertical size of the font
new cf; % conversion factor, approximately equal to \\{pixels}
new h,hh,hhh,d,dd,m,e,o,oo,b,s,ssd,ssdoo,as,a; % raster-oriented vertical dimensions
new del; del=round pixels.pdel; % raster-oriented displacement at corners
new w0,w1,w2,w3,w4,w5,w6,w10,w11; % raster-oriented pen sizes
new w15,w16,w17,w18,w19,w20,w21,w22,w25,w26,w30; % ditto, second-generation
new scorr,hcorr,bow; % more second-generation stuff
new deltaw,bold; % unrounded raster-oriented pen size values
new armic,lcic; % italic corrections commonly used
w0=round(pixels.pw+blacker); % hairline width
w1=round(pixels.pwi+blacker); % stem width
w2=round(pixels.pwii+blacker); % curve width
w3=round(pixels.pwiii+blacker); % basis for bulbs and terminals
w4=round(pixels.pwiv+blacker); % uppercase stem width
w5=round(pixels.pwv+blacker); % uppercase curve width
w6=round(pixels.aspw+blacker); % hairline height
new w7; w7=round(.85pixels.pwi+blacker); % patch for stem height
new w8; w8=round(.85pixels.pwii+blacker); % patch for curve height
new w9; w9=round(.85pixels.pwiv+blacker); % patch! the old w9 is gone
%prt=.25[pw,pwii]; % rule thickness in points, it's now a parameter
w10=-round(-pixels.prt-.5); % raster-oriented rule thickness
% the above corresponds to TEX82 rule about rules
if pw>.5pwi: w11=round(pixels(.6[aspw,pwi])+blacker);
else:w11=round(pixels(.3[pw,pwi])+blacker); % between hairline and stem
fi;
deltaw=pixels.(pwii-pwi); % one step of boldening
bold=pwii.pixels+blacker; % background for boldening
w15=round(pixels.psmid+blacker); % height of stroke in middle of "s"
w16=round(pixels.puw+blacker); % width of hairlines in upper case
w17=round(pixels.pwb+blacker); % thickness of uppercase bowl bars
w18=round(pixels.pwu+blacker); % thickness of bars in upper case
w19=round(pixels.pws+blacker); % serif and arm thickness
w20=round(pixels.pww+blacker); % small hairline width
scorr=pixels.pscorr; % some stems to be this much thinner
w21=w1-round(scorr); % light stem width
bow=round(pixels.pbow); % amount of bowing to erase from serifs
hcorr=pixels.phcorr; % some hairlines to be this much thicker or thinner
if pws-2phcorr+eps<aspw: error; % restriction on parameter sizes
fi;
if round(w19-2hcorr)<w6: new hcorr; w19-2hcorr=w6-.49;
fi; % the programs can assume that round(w19-2hcorr)≥w6
w22=round(w6+hcorr); % heavy hairline height % "round" added July 7 '83
w30=round(pixels.pdot+blacker); % basis for dots
if aspw>.5fudge.fudge.pwi: w26=round(.375fudge.fudge.w1+.5);
w25=round(.25fudge.fudge.w1+.5);
else: w26=round(.75w6); w25=round(.5w6);
fi; % smaller radii for certain corners
% The following corrections are for low resolution:
if w3/w1>5/4(pwiii/pwi): new w2,w3; w2=w3=w1;
fi;
if w2/w1>1.1(pwii/pwi): new w2; w2=w1;
fi;
if w5/w4>1.1(pwv/pwiv): new w5; w5=w4;
fi;
if w0<3: new crisp; crisp=0;
fi;
hpenht w6; vpenwd w0; lpenht w6; rpenht w6;
typesize=ph+pd+2pb; cf.typesize=pixels.typesize-1;
h=round cf.ph; d=round cf.pd;
hh=round cf.phh; hhh=round cf.phhh; dd=round cf.pdd;
m=round cf.px; a=.5 round 2cf.pa;
o=round cf.po.overcorr; oo=round .5cf.po.overcorr;
s=cf.ps; ssd=round cf.pssd; as=cf.pas+eps;
if ssd>oo: ssdoo=oo;
else: ssdoo=ssd;
fi;
b=-round(.5(h+d-typesize.pixels));
e=cf.pe;
maxht h+b+4;
trxy slant;
if ucs≠0: armic=phh.slant-pu;
else: armic=phh.slant-.5pu;
fi; % armic and lcic should really be calculated in romanu and romanl...
if pwii>1.5pu: lcic=-.25pu;
else: lcic=.5pwii-pu;
fi.
subroutine charbegin(var charno) % seven-bit character code
(var charuw) % character width in units
(var lftcorr, var rtcorr) % sidebar corrections in units
(var charh, var chard, var chari): % \&{charht}, \&{chardp}, \&{charic} values in points
no eqtrace; no calltrace; no drawdisplay; % no tracing in this subroutine
new uw,moduw; % the correct character width in units
new r; % raster-oriented character width
new u; % raster-oriented design unit
new tu; % unmodified raster-oriented unit
new italcorr; % italic correction
new lcorr,rcorr; % left and right corrections
if chari≥0: italcorr=chari; else: italcorr=0;
fi;
if danger≠0: % rounding of character width is necessary
lcorr=danger.round((lftcorr-ls)/danger);
rcorr=danger.round((rtcorr-ls)/danger);
else: lcorr=lftcorr-ls; rcorr=rtcorr-ls;
fi;
tu=pu.pixels; uw=charuw-(lcorr+rcorr);
if fixwidth=0: moduw=uw;
else: moduw=9; new italcorr; italcorr=(ph+pb).slant;
fi;
r=charuw.(u+eps)=round((moduw.tu-2).charuw/uw);
% u+eps is better than u, because otherwise "round c.u" and "round(r-c.u)"
% will both be biased upwards when c-u is exactly integer+.5
% and similar phenomena would occur in other calculations re u (e.g. serifs)
charcode charno; charic italcorr;
if charh>0: charht charh;
else: charht 0;
fi;
if chard>0: chardp chard;
else: chardp 0;
fi;
charwd moduw.pu; chardw moduw.tu;
%incx round(-lcorr.tu);
incx round(-lftcorr.tu)+round(ls.tu); % makes letterspacing more consistent
% because e.g. ital font sometimes has ls, sometimes ls-1 as the sidebar correction
if mode=smoke: call corners(round lcorr.u,(round lcorr.u)+u.uw); fi.
subroutine newic(var corr): % change the italic correction
new italcorr;
if corr>0: italcorr=fixwidth[corr,0];
else: italcorr=0;
fi;
charic italcorr.
subroutine box(var offset): % Draw guidelines and box around a character:
no drawtrace; no proofmode;
new topp,bott,left,right,pos;
topp=h+b; bott=-d-b;
left=offset; right=offset+u.uw;
x1=x3=x5=x7=x9=x11=x13=x15=x17=left;
x2=x4=x6=x8=x10=x12=x14=x16=x18=right;
y1=y2=0; cpen; 1 draw1..2; % baseline
y3=y4=e; draw3..4; % e-height
y5=y6=m; draw5..6; % mean line (x-height)
y7=y8=h; draw7..8; % h-height
y9=y10=topp; draw9..10; % top of character
y11=y12=-d; draw11..12; % descender line
y13=y14=bott; draw13..14; % bottom of character
trxy 0; % temporarily turn off the slant
y15=y16=topp; y17=y18=bott;
draw15..17; draw16..18; % left and right edges
if italcorr>0: x19=x20=right+italcorr.pixels;
y19=topp; y20=0; draw 19..20; % show italic correction
fi;
trxy slant; % restore slanted transformation
pos=0; call unitlines. % draw the unit guidelines
subroutine unitlines: % Recursive subroutine to draw guidelines:
x1=x2=pos;y1=topp;y2=bott;cpen;
if pos≥left: 1 draw1..2;
fi;
new pos; pos=x1+u;
if pos≤right: call unitlines;
fi.
subroutine corners(var lfttt, var rttt):
no drawdisplay; no proofmode; no drawtrace; no plottrace;
x1=x2=x3=x4=x5-10=x6-10=lfttt;
x7+10=x8+10=x9=x10=x11=x12=rttt;
y1=y2+10=y5=y7=y9=y10+10=hh;
y3-10=y4=y6=y8=y11-10=y12=0;
cpen; 1 draw 2..1..1..5; draw 7..9..9..10; draw 3..4..4..6; draw 8..12..12..11.
subroutine arithbegin(var c): % character code of arithmetic operator
% The common operators (plus, minus, times, plus-or-minus, ... )
% are given consistent heights and depths by this routine.
if fixwidth=0: call charbegin(c,14,0,0,pa+6pu,6pu-pa,pa.slant-.5pu);
else: call charbegin(c,9,0,0,3.5pu+pa,3.5pu-pa,0);
fi.
% The following subroutines are used to draw common features of characters.
subroutine dot(index i) % center of dot
(index j): % index of $w$-variable for dot size
cpen;
if sqdot=0: wj draw i; % round dot
else: top6y1=top j yi; bot6y2=bot j yi;
x1=x2=xi; hpen; wj draw 1..2; % squarish dot
fi.
subroutine comma(index i) % center of dot in comma
(index j) % index of $w$-variable for dot size
(var theta): % ``openness''
cpen;
if sqdot=0: wj draw i; % round dot
top6y1=top j yi; bot6y3=bot j yi-dd; y2=1/3[y1,y3];
x1=xi; rt6x2=round(rt j xi +theta.pixels.pu); x3=good6(xi-.5pixels.pu);
w6 draw 1{1,0}..2{0,-1}..3{4(x3-x2),y3-y2};
else: new w95; w95=round .5w6;
call dot(i,j); % squarish dot
bot95y14=bot j yi; y13=y14; lft95x13=round(lft j xi+.3wj+.501);
rt95x14=rt j xi;
y12=yi; x12=x14;
bot95y15=bot j yi-dd; y15=y16;
lft95x15=lft j xi; x15=x16-((round.5wj)-w95);
w95 ddraw 12..13, 12..14; ddraw 13..15, 14..16; % taper
fi.
subroutine ucomma(index i) % center of dot of inverted apostrophe
(index j) % index of $w$-variable for dot size
(var theta): % ``openness''
% there is rotational symmetry with respect to the previous subroutine
cpen;
if sqdot=0: wj draw i; % round dot
bot6y1=bot j yi; top6y3=top j yi+dd; y2=1/3[y1,y3];
x1=xi; lft6x2=round(lft j xi-theta.pixels.pu); x3=good6(xi+.5pixels.pu);
w6 draw 1{-1,0}..2{0,1}..3{4(x3-x2),y3-y2}; % tail
else: new w95; w95=round .5w6;
call dot(i,j); % squarish dot
top95y14=top j yi; y13=y14; rt95x13=round(rt j xi-.3wj-.501);
lft95x14=lft j xi; y12=yi; x12=x14;
top95y15=top j yi+dd; y15=y16;
rt95x15=rt j xi; x15=x16+((round.5wj)-w95);
w95 ddraw 12..13, 12..14; ddraw 13..15, 14..16; % taper
fi.
subroutine serif(index i) % point where serif appears
(index k) % $w$-variable for stem line
(index j) % another point on the stem line
(var theta) % fill-in ratio
(var sl): % serif length
cpen;
if yi<yj: y2=yi+s+(w19-w20); bot20y11=bot6yi; y1=y11+(w19-w20); y5=y4+(w19-w6);
else: y2=yi-s-(w19-w20); top20y11=top6yi; y1=y11-(w19-w20); y5=y4-(w19-w6);
fi;
if sl<0: lft20x1=lft k xi+sl.u;
lft20x2=lft k (y2-yi)/(yj-yi)[xi,xj];
else: rt20x1=rt k xi+sl.u;
rt20x2=rt k (y2-yi)/(yj-yi)[xi,xj];
fi;
no proofmode; x1=x11; x12=xi; y12=y11; y4=yi;
x3=theta[x1-sl.u,1/2[x1,x2]];
y3=theta[y1,1/2[y1,y2]];
minvr 0; minvs 0;
w20 ddraw 1{xi-x1,0}..3{x2-x1,y2-y1}..2{xj-xi,yj-yi}, 11..12..2; % serif stroke
minvr 0.5; minvs 0.5;
if crisp≠0: if round(w20/2)=w20/2: x4=x1-.5;
else: x4=x1;
fi;
x5=x4;
if sl<0: lpen; .5w20-1 draw 4..5;
else: rpen; .5w20-.5 draw 4..5;
fi;
fi.
subroutine dserif(index i) % point where dark serif appears
(index k) % $w$-variable for stem line
(index j) % another point on the stem line
(var theta) % fill-in ratio
(var sl): % serif length
x1=s; new s; s=1.5x1;
call serif(i,k,j,theta,sl);
new s; s=x1.
subroutine sserif(index i) % point where sheared serif appears
(index k) % $w$-variable for stem line
(index j) % another point on the stem line
(var theta) % fill-in ratio
(var sl): % serif length
hpen; lft0x1=lft k xi + sl.u; x3=xi; rt0x2=rt k xi;
y1=y3=yi-ssd; y2=yi;
lpen#; wk draw 2..1; % erase excess
if crisp=0: hpen; w0 ddraw 2..1,3..1; % diagonal down to the spur
else: lpen; (w0-1-eps)/2 ddraw 2..1,3..1; % diagonal down to the spur
rpen; (w0-1-eps)/2 draw 2; cpen; w6 draw 2;
fi;
call serif(3,k,j,theta,sl). % spur
subroutine rsserif(index i) % point where reverse sheared serif appears
(index k) % $w$-variable for stem line
(index j) % another point on the stem line
(var theta) % fill-in ratio
(var sl): % serif length
hpen; rt0x1=rt k xi + sl.u; x3=xi; lft0x2=lft k xi;
y1=y3=yi+ssd; y2=yi;
rpen#; wk draw 2..1; % erase excess
if crisp=0: hpen; w0 ddraw 2..1,3..1; % diagonal down to the spur
else: rpen; (w0-1-eps)/2 ddraw 2..1,3..1; % diagonal down to the spur
lpen; (w0-1+eps)/2 draw 2; cpen; w6 draw 2;
fi;
call serif(3,k,j,theta,sl). % spur
subroutine notch(index i) % top middle
(index j) % top edge
(index d) % diameter of pen
(index k) % bottom middle
(index l): % untouchable point at base of notch
%new rho;
%if xi<xk: x9=rt d xj;
%else: x9=lft d xj;
%fi;
%y9=yj; x7=xl; (yi-yk)(x9-x7)=(y9-y7)(xi-xk); y8=y7; x7-x8=x9-xj;
%rho=sqrt((y7-yl)(y7-yl)/((xi-xk)(xi-xk)+(yi-yk)(yi-yk)));
%x1-x8=rho(xi-xk); y1-y8=rho(yi-yk);
%if (yi-yk)(yj-y1)≤0: new x1,y1; x1=xj; y1=yj;
%fi;
%cpen; y1=y2; x1-xj=x2-xi;
cpen; y3=yl; x4=x5=xl; y4=y6; y5=yk;
if yi>yk: top d y4=yl-1;
else: bot d y4=yl+1;
fi;
if xi>xk: lft d x3=xl+1;
if x5>xk: new x5; x5=xk;
fi;
else: rt d x3=xl-1;
if x5<xk: new x5; x5=xk;
fi;
fi;
new aa; y6=aa[yi,yk]; x6=aa[xi,xk];
minvr 0.0; minvs 0.0;
%wd ddraw i..2..k, j..1{xk-xi,yk-yi}..3{0,yk-yi}; % half-diagonal
wd ddraw i..k, j{xk-xi,yk-yi}..3{0,yk-yi}; % half-diagonal
minvr 0.5; minvs 0.5;
ddraw 6..4, k..5. % fill in under the notch
subroutine diag(index i) % sharp corner
(index j) % corner with edge at left or right
(index k) % corner with edge at top or bottom
(index l) % corner opposite $i$
(index di) % smaller diameter (at $i$)
(index d): % larger diameter (at $j$, $k$, $l$)
cpen; y1=yj; x2=xk;
if xi<xk: lft di x1=lft d xj;
else: rt di x1=rt d xj;
fi;
if yi>yj: top di y2=top d yk;
else: bot di y2=bot d yk;
fi;
wdi ddraw 1..i, 1..2; % the $i$ half of the parallelogram
wd ddraw j..k, l..k. % the $l$ half of the parallelogram
subroutine easydiag(index i) % top point
(index k) % width at top
(index j) % bottom point
(index l) % width at bottom
(index d): % height at top and bottom
% simpler than diag, since a cpen of diameter $d$ can be used
cpen; lft k xi=lft d x1; rt k xi=rt d x2; y1=y2=yi;
lft l xj=lft d x3; rt l xj=rt d x4; y3=y4=yj;
wd ddraw 1..3, 2..4. % diagonal
%subroutine darc(index i) % starting point
% (index j) % opposite corner point
% (var maxwidth): % the pen grows from $w↓0$ to this size
%x5=xi; x2=x4=1/sqrttwo [xi,xj]; x3=xj;
%y5=yj; y3=1/2[yi,yj];
%y2=1/sqrttwo [y3,yi]; y4=1/sqrttwo [y3,yj];
%hpen; draw |w0|i{x3-xi,0}..|2/3[w0,maxwidth]|2{x3-xi,y3-yi}..
% |maxwidth#|3{0,y3-yi}..
% |2/3[w0,maxwidth]|4{x5-x3,y5-y3}..|w0|5{x5-x3,0}.
subroutine arc(var theta) % ratio to bring out the inside curve
(index i) % horizontal endpoint
(index k) % thickness at horizontal endpoint
(var delta) % offset for interior horizontal endpoint
(index j) % vertical endpoint
(index l): % thickness at vertical endpoint
cpen;
new w84;
if wk<w20: w84=wk;
else: w84=w20;
fi;
if wl<w84: new w84; w84=wl;
fi;
if yi>yj: top k yi=top84y1; bot k yi=bot84y2;
else: bot k yi=bot84y1; top k yi=top84y2;
fi;
if xi<xj: lft l xj=lft84x6; rt l xj=rt84x5;
else: rt l xj=rt84x6; lft l xj=lft84x5;
fi;
x1=xi; x2=xi+delta; y5=y6=yj;
x3=1/sqrttwo[x1,x5]; x4=theta[1/sqrttwo[x2,x6],x3];
y3=1/sqrttwo[y5,y1]; y4=theta[1/sqrttwo[y6,y2],y3];
w84 ddraw 1{x5-x1,0}..3{x5-x1,y5-y1}..5{0,y5-y1},
2{x6-x2,0}..4{x6-x2,y6-y2}..6{0,y6-y2}. % quarter-bowl
% DESTROY THIS ONE WHEN YOU CAN
%subroutine oldarc(index i) % horizontal endpoint
% (index j) % vertical endpoint
% (var maxwidth): % the pen grows from $w↓0$ to this size
%x1=1/sqrttwo[xi,xj]; y1=1/sqrttwo[yj,yi];
%hpen; draw |w0|i{xj-xi,0}..|2/3[w0,maxwidth]|1{xj-xi,yj-yi}..
% |maxwidth|j{0,yj-yi}.
subroutine arm(index i) % starting point
(index j) % horizontal endpoint
(index k) % serif endpoint
(var delt) % thickness control
(var thicker): % additional overall thickness
% the last parameter should be negative to make upper arms thicker
% $y↓k$ should be (at least slightly) less than $y↓j$ in upper arms
hpen;
x4=xi; y4=good6(yi+thicker); x5=xj; y5=good6(yj+thicker);
y7=good6yk;
if ucs≠0:
if pw>.5pwi: x1=x6=xk; y1=yj; y6=y5;
w0 ddraw 4..6, i..1; draw 1..k;
else: minvr 0; minvs 0;
x1=xj-delt; y1=.2[y5,y7];
x2=x7=xk; y2=2[y5,y7];
x3=x6=.5[xi,x1]; y3=yi; y6=y4;
w0 ddraw i..3..j..7, 4..6{x6-x4,0}..1..7(..2);
minvr 0.5; minvs 0.5;
fi;
else: new w73; w73=round .75w6; cpen; y11=y12; x11=x14=xi; x12=x13;
if yk<yj: top73y11=top6yi; bot73y14=bot6y4; bot73y13=bot6y7;
else: bot73y11=bot6yi; top73y14=top6y4; top73y13=top6y7;
fi;
if xi<xj: rt73x12=rt0xk;
else: lft73x12=lft0xk;
fi;
w73 ddraw 11..12, 14..13;
fi.
subroutine scomp(index i) % starting point
(index p) % turning point ($y↓p$ to be defined)
(index j) % transition point (to be defined)
(index k) % ending point
(var slope): % ending slope
% This subroutine computes $y↓p$, $x↓j$, $y↓j$ so that $y↓k-y↓j=\\{slope}.(x↓k-x↓j)$
% and so that the following curve is consistent with an ellipse:
% $i\{x↓p-x↓i,0\}\to p\{0,y↓p-y↓i\}\to j\{x↓k-x↓p,\\{slope}.(x↓k-x↓p)\}$.
yk-yj=slope(xk-xj);
new aa,bb; aa=slope(xp-xi); bb=yk-yi-slope(xk-xi);
xj-xi=-2aa.bb(xp-xi)/(aa.aa+bb.bb);
yp-yi=.5(bb.bb-aa.aa)/bb.
subroutine sdraw(index i) % starting point
(index p) % upper turning point ($y↓p$ to be defined)
(index k) % middle point
(index q) % lower turning point ($y↓q$ to be defined)
(index j) % ending point
(var ppenwd) % width control at $p$
(var qpenwd) % width control at $q$
(var penht) % height control at $k$
(var tth) % thickness at the top
(var bth) % thickness at the bottom
(var slope): % slope at point $k$
new w47,w48,w49,w50,w51; w47=round ppenwd; w48=round qpenwd; w49=penht;
w50=tth; w51=bth;
cpen; top20y5=top49yk; bot20y6=bot49yk; x5=x6=xk;
if xp<xi: rt47xp=rt20x1; lft47xp=lft20x2; rt48xq=rt20x9; lft48xq=lft20x10;
else: lft47xp=lft20x1; rt47xp=rt20x2; lft48xq=lft20x9; rt48xq=rt20x10;
fi;
y2=yp; y9=yq;
x11=x12=xi; top20y12=top50yi; bot20y11=bot50yi;
call scomp(11,1,3,5,slope); % compute $y↓1$ and point 3
call scomp(12,2,4,6,slope); % compute $y↓2$ and point 4
if (yi-y1+eps)/(xi-x1+eps)/(xi-x1+eps)<(yi-y2+eps)/(xi-x2+eps)/(xi-x2+eps):
% error; % OK to go on; but I should fix this code later!
new x1,y1,aa,x3,y3; % correction to keep ellipses from crossing
2(yi-y2+eps)/(xi-x2+eps)/(xi-x2+eps)=(yi-y5+eps)aa-slope.slope/(yi-y5+eps);
if xp<xi: xi-x1=1/sqrt aa;
else: xi-x1=-1/sqrt aa;
fi;
call scomp(i,1,3,5,slope); % recompute $y↓1$ and point 3
fi;
x13=x14=xj; top20y14=top51yj; bot20y13=bot51yj;
call scomp(13,9,7,5,slope); % compute $y↓9$ and point 7
call scomp(14,10,8,6,slope); % compute $y↓{10}$ and point 8
if (yj-y10+eps)/(xj-x10+eps)/(xj-x10+eps)>(yj-y9+eps)/(xj-x9+eps)/(xj-x9+eps):
% error; % OK to go on; but I should fix this code later!
new x10,y10,aa,x8,y8; % correction to keep ellipses from crossing
2(yj-y9+eps)/(xj-x9+eps)/(xj-x9+eps)=(yj-y6+eps)aa-slope.slope/(yj-y6+eps);
if xq<xj: xj-x10=1/sqrt aa;
else: xj-x10=-1/sqrt aa;
fi;
call scomp(j,10,8,6,slope); % recompute $y↓{10}$ and point 8
fi;
w20 ddraw 11{x1-x11,0}..1{0,y1-y11}..3{xq-xp,slope(xq-xp)}..
7{xq-xp,slope(xq-xp)}..
9{0,y13-y9}..13{x13-x9,0},
12{x2-x12,0}..2{0,y2-y12}..4{xq-xp,slope(xq-xp)}..
8{xq-xp,slope(xq-xp)}..
10{0,y14-y10}..14{x14-x10,0}. % the s-curve
subroutine zcomp(index i) % starting point
(index p) % turning point ($x↓p$ to be defined)
(index j) % transition point (to be defined)
(index k) % ending point
(var slope): % reciprocal of ending slope
% This subroutine is dual to \\{scomp}.
% It computes $x↓p$, $x↓j$, $y↓j$ so that $x↓k-x↓j=\\{slope}\cdot(y↓k-y↓j)$
% and so that the following curve is consistent with an ellipse:
% $i\{0,y↓p-y↓i\}\to p\{x↓p-x↓i,0\}\to j\{\\{slope}.(y↓k-y↓p),y↓k-y↓p\}$.
xk-xj=slope(yk-yj);
new aa,bb; aa=slope(yp-yi); bb=xk-xi-slope(yk-yi);
yj-yi=-2aa.bb(yp-yi)/(aa.aa+bb.bb);
xp-xi=.5(bb.bb-aa.aa)/bb.
subroutine zdraw(index i) % starting point
(index p) % left turning point ($x↓p$ to be defined)
(index k) % middle point
(index q) % right turning point ($x↓q$ to be defined)
(index j) % ending point
(var penht) % effective height of hpen used
(var penwd) % effective pen width at point $k$
(var slope): % reciprocal of slope at point $k$
% This subroutine is dual to \\{sdraw}.
new w48,w49; w48=penwd; w49=penht;
cpen; lft0x5=lft48xk; rt0x6=rt48xk; y5=y6=yk;
if yp>yi: bot49yp=bot6y1; top49yp=top6y2;
bot49yq=bot6y9; top49yq=top6y10;
else: top49yp=top6y1; bot49yp=bot6y2;
top49yq=top6y9; bot49yq=bot6y10;
fi;
x2=xp; x9=xq;
call zcomp(i,1,3,5,slope); % compute $x↓1$ and point 3
call zcomp(i,2,4,6,slope); % compute $x↓2$ and point 4
if (xi-x1)/(yi-y1)/(yi-y1)>(xi-x2)/(yi-y2)/(yi-y2):
new x1,y1,aa,x3,y3; % correction to keep ellipses from crossing
2(xi-x2)/(yi-y2)/(yi-y2)=(xi-x5)aa-slope.slope/(xi-x5);
if yp<yi: yi-y1=1/sqrt aa;
else: yi-y1=-1/sqrt aa;
fi;
call zcomp(i,1,3,5,slope); % recompute $x↓1$ and point 3
fi;
call zcomp(j,9,7,5,slope); % compute $x↓9$ and point 7
call zcomp(j,10,8,6,slope); % compute $x↓{10}$ and point 8
if (xj-x10)/(yj-y10)/(yj-y10)<(xj-x9)/(yj-y9)/(yj-y9):
new x10,y10,aa,x8,y8; % correction to keep ellipses from crossing
2(xj-x9)/(yj-y9)/(yj-y9)=(xj-x6)aa-slope.slope/(xj-x6);
if yq<yj: yj-y10=1/sqrt aa;
else: yj-y10=-1/sqrt aa;
fi;
call zcomp(j,10,8,6,slope); % recompute $x↓{10}$ and point 8
fi;
hpen; w0 ddraw i{0,y1-yi}..1{x1-xi,0}..3{slope(yq-yp),yq-yp}..
7{slope(yq-yp),yq-yp}..
9{xj-x9,0}..j{0,yj-y9},
i{0,y2-yi}..2{x2-xi,0}..4{slope(yq-yp),yq-yp}..
8{slope(yq-yp),yq-yp}..
10{xj-x10,0}..j{0,yj-y10}. % the s-curve
subroutine bar(index i, index j, index p, index q):
% This subroutine is similar to ``\&{vpen};\quad $w↓p$ \&{draw} $i\to j$'',
% but the \&{vpen} slants with italic.
no proofmode; % the points computed aren't interesting
cpen; top q y1=top p yi; bot q y2=bot p yi;
top q y3=top p yj; bot q y4=bot p yj;
lft q x1=lft q x2=lft0xi; rt q x3=rt q x4=rt0xj;
w q ddraw 1..3, 2..4.
subroutine lterm(index i) % point where the terminal is to be centered
(index k): % height of the terminal
no proofmode;
cpen; x1=x2=xi; bot6y1=bot k yi; top6y2=top k yi;
lpen#; w6 draw 1..2; % erase excess at left
vpenwd w6; % next edition of MF will allow you to specify any rect ellipse
vpen; wk draw i; % terminal
vpenwd w0.
subroutine rterm(index i) % point where the terminal is to be centered
(index k): % height of the terminal
no proofmode;
cpen; x1=x2=xi; bot6y1=bot k yi; top6y2=top k yi;
rpen#; w6 draw 1..2; % erase excess at right
vpenwd w6; % next edition of MF will allow you to specify any rect ellipse
vpen; wk draw i; % terminal
vpenwd w0.
subroutine fstroke(index i) % dot position or bottom of terminal
(index j) % $x$-coordinate of stem
(index k) % width of lower stem
(index l) % $y$-coordinate of top of terminal
(var sl): % length of right serif
new w74; w74=round(wk-scorr);
hpen; bot1yj=0; lft74x0=lft k xj; x10=xj; y10=y0; top k y10=m;
%y1=.5[m,h]; x1=x0; x2=.5[x1,x3];
top6y1=.5[m,h]; x1=x0; x2=.5[x1,x3];
wk draw j..10; w74 draw 0..1; % stem
lft74x1=lft20x14; rt74x1=rt20x11; y11=y14=y1;
if lcs=0: cpen; x3=xi;
% top6y2=h+oo; call `a arc(0,2,6,0,1,74); % shoulder
x26=x11; y26=.5[m,h]; w20 ddraw 14..11, 14..26; % link
x21=x22=x2; top20y21=h+oo; y22=y21-(w6-w20);
x24=1/sqrttwo[x22,x26]; x23=1/sqrttwo[x21,x14];
y24=1/sqrttwo[y26,y22]; y23=1/sqrttwo[y14,y21];
w20 ddraw 26{0,1}..24{x22-x26,y22-y26}..22{1,0},
14{0,1}..23{x21-x14,y21-y14}..21{1,0}; % shoulder
% xl=good20(xi-(1.5u/h)(yl-yi));
xl=xi;
w20 ddraw l{x21-xl,2(y21-yl)}..21{-1,0},
i{x22-xi,3(y22-yi)}..22{-1,0}; % terminal
else: cpen; rt20x3=rt3xi; y3=y13=yi; x13=x3-(w0-w20);
w3 draw i; % bulb
top20y12=h+oo; y2=y12-(w6-w20);
new aa; y2=aa[y11,y12]; x2=aa[x11,x12];
w20 ddraw 14{0,1}..12{1,0}..3{0,-1},
11{0,1}..2{1,0}..13{0,-1}; % shoulder
new aa;
if w1+2lcs.u>4.5u-1: w1+2(lcs-aa).u=4.5u-1;
if r<7u: new aa; aa=0; % this correction not needed for simple f
fi;
else: aa=0;
fi;
call `a serif(j,k,1,1/3,-lcs+aa);
call `b serif(j,k,1,1/3,sl-aa);
call `c bserif(j,k,-lcs+aa,sl-aa); % serif
fi.
subroutine hstroke(index i) % $x$-coordinate of left stem
(index j) % $x$-coordinate of right stem
(index k): % will be set to base of right stem
hpen; xk=xj; bot1yk=0;
rt20x1=rt1xi; y1=1/8[e,m]; yj=1/3[e,m];
x9=x0=xi; y9=y1; bot1y0=0; w1 draw 0..9; % thicken the bottom stem
cpen;
y4=y6=yj; lft20x4=lft1xj; rt20x6=rt1xj;
%x5=x6-2.15u; top20y5=m+oo;
x5=.5[rt20x1,rt20x6]; top20y5=m+oo;
y5-y3=w6-w20;
new alpha; y3=alpha[y1,y5]; x3=alpha[x1,x5];
new stwo; stwo = sqrt 1.23114413sqrttwo; % the constant is $2↑{3/10}$
x7=theta[1/sqrttwo[x3,x4],x8]; y7=theta[1/sqrttwo[y4,y3],y8];
x8=1/stwo[x5,x6]; y8=1/stwo[y6,y5];
w20 ddraw 1{0,1}..5{1,0}..8{x6-x5,y6-y5}..6{0,-1},
1{0,1}..3{1,0}..7{x4-x3,y4-y3}..4{0,-1}; % shoulder
hpen; w1 draw j..k. % stem
subroutine bserif(index i) % point where bowed serif appears
(index k) % w-variable for stem line
(var lsl) % left serif length
(var rsl): % right serif length
if bow≠0: hpen; top0y1=bot0yi-1; y2=y1+bow; y3=y1; x2=xi;
lft0x1=lft k xi+lsl.u;
rt0x3=rt k xi+rsl.u;
cpen#; w6 draw 1{x2-x1,3(y2-y1)}..2{1,0}..
3{x3-x2,3(y3-y2)}; % erase bowed part
fi.
subroutine ubserif(index i) % point where upper bowed serif appears
(index k) % w-variable for stem line
(var lsl) % left serif length
(var rsl): % right serif length
if bow≠0: hpen; bot0y1=top0yi+1; y2=y1-bow; y3=y1; x2=xi;
lft0x1=lft k xi+lsl.u;
rt0x3=rt k xi+rsl.u;
cpen#; w6 draw 1{x2-x1,3(y2-y1)}..2{1,0}..
3{x3-x2,3(y3-y2)}; % erase bowed part
fi.
subroutine cdraw(index i, index j) % given points
(index p, index q): % given widths, $w↓p≥w↓q$
% An implementation of the forbidden ``\&{cpen};\quad\&{draw} $|w↓p|i\to |w↓q|j$''.
% I should change the calling sequence to cdraw(i,p,j,q), or change other calls...
cpen; wp draw i; % plot the bigger dot
new aa; (aa+eps)sqrt((xj-xi)(xj-xi)+(yj-yi)(yj-yi))=wp-wq;
x2-x1=aa(yi-yj); y2-y1=aa(xj-xi);
xi=.5[x1,x2]; yi=.5[y1,y2]; % perpendicular points
wq ddraw 1..j, 2..j. % fill in the rest
subroutine qcirc(index i) % horizontal endpoint
(index j) % intermediate point
(index k) % vertical endpoint
(var size): % size of \&{cpen} that draws a quarter circle
cpen; xj=1/sqrttwo[xi,xk]; yj=1/sqrttwo[yk,yi];
size draw i{xk-xi,0}..j{xk-xi,yk-yi}..k{0,yk-yi}.
subroutine hcirc(index viii, index i, index ii, index iii, index iv, var size):
xiv=xviii; yii=.5[yiv,yviii];
call qcirc(viii,i,ii,size); call qcirc(iv,iii,ii,size).
subroutine circle(index i, index ii, index iii, index iv,
index v, index vi, index vii, index viii, var size):
xiv=xviii=.5[xvi,xii]; yii=yvi=.5[yiv,yviii];
call qcirc(viii,i,ii,size); call qcirc(iv,iii,ii,size);
call qcirc(iv,v,vi,size); call qcirc(viii,vii,vi,size).
subroutine entry(var z) % $x$-coordinate for upward stroke
(index j): % $x$-coordinate for downward stroke ($y↓j$ will be set)
% This subroutine draws a little hook at the beginning left of an italic character,
% ending with the pen traveline vertically at point $j$ with size $w↓1$.
hpen; x1=good0z; y1=2/3m; yj=3/4m; x2=xj-1.5u; top0y2=m+oo;
draw |w0|1{(xj-2.5u)-x1,m}..|w0#|2{1,0}..|w1#|j{0,-1}.
subroutine skewentry(var z) % $x$-coordinate for upward stroke
(index j): % $x$-coordinate for downward stroke ($y↓j$ will be set)
% This subroutine is analogous to \\{entry}, but the pen starts out vertical
% and ends at the skewed slope $\{-u,-m\}$ to compensate for optical illusion.
hpen; x1=good0z; y1=2/3m; yj=3/4m;
x2=xj-1.25u; top0y2=m+oo;
draw |w0|1{0,1}..|w0#|2{1,0}..|w1#|j{-u,-m}.
subroutine exit(index i) % $x$-coordinate for downward stroke ($y↓i$ will be set)
(var z): % $x$-coordinate for upward stroke
% This subroutine draws a little hook at the ending right of an italic character,
% beginning with the pen traveling vertically at point $i$ with size $w↓1$.
hpen; x2=good0z; y2=1/3m; yi=1/4m; x1=xi+1.5u; bot0y1=-oo;
draw |w1#|i{0,-1}..|w0#|1{1,0}..2{x2-(xi+2.5u),m}.
subroutine skewexit(index i) % $x$-coordinate for downward stroke ($y↓i$ will be set)
(var z): % $x$-coordinate for upward stroke
% This subroutine is analogous to \\{exit}, but the pen begins with the skewed
% slope $\{-u,-m\}$ to compensate for optical illusion, and ends vertically.
hpen; x2=good0z; y2=1/3m; yi=1/4m; x1=xi+1.25u; bot0y1=-oo;
draw |w1#|i{-u,-m}..|w0#|1{1,0}..2{0,1}.
subroutine italhstroke(index i) % starting point
(index j): % $x$-coordinate of right stem ($y↓j$ will be set)
hpen; x1=.6[xi,xj]; x2=xj-.4u; top0y1=m+oo; y2=.75[e,y1];
yj=.3[e,m];
draw |w0|i{0,1}..|w0#|1{1,0}..|.75[w0,w1]|2..|w1#|j{0,-1}.
subroutine pistroke: % makes the bar of pi, tau, variant omega
vpen; x1=good0(0); y1=m-m/3.14159;
x2=2u; top7y2=m; y3=y2; x3=r-1.5u;
draw |w6#|1{x2-x1,3.14159(y2-y1)}..|w7#|2{1,0}..3; % bar
cpen; w7 draw 3. % make the end point round
subroutine endv(index i): % draws final bulb starting at this point
cpen; x1=xi-u; x2=xi-6u; top2y1=m+oo; y2=y1;
hpen; draw |w0#|i{0,1}..|w2#|1(..2); % stroke
cpen; w2 draw 1. % bulb
subroutine max(var a, var b): % sets $\\{acc}=\max(a,b)$
new acc;
if a>b: acc=a;
else: acc=b;
fi.
% From file AMR10.MF[MF,SYS]
call fontbegin;
% input roman;
% From file ROMAN[MF,SYS]
% The Computer Modern Roman family of fonts (by D. E. Knuth, 1979--1981)
danger=mi=dc=italic=0;
if ligs≠0: spanx='074; spanq='076;
else: spanx='016; spanq='017;
fi;
% input romanu; % upper case (majuscules)
% From file ROMANU[MF,SYS]
% Computer Modern Roman upper case:
% These letters were originally coded by D. E. Knuth in November, 1979,
% inspired by the Monotype alphabets used in {\sl The Art of Computer Programming}.
% For text spacing, set $\\{mi}=0$; for math spacing, set $\\{mi}=1$.
% Character codes $\\{dc}+\¬101$ through $\\{dc}+\¬132$ are generated.
% Note that each character code is shifted by the amount \\{dc}.
% For example, when making `caps and small caps' fonts, set $\\{dc}=\¬40$,
% to get the upper case letters moved into lower case positions.
new mc,lbowl,rbowl,rstem,rv,hic; % quantities used to compute spacing
mc=mi/pu; % converts to relative units when $\\{mi}=1$
lbowl=.3phh.slant+.5pu; % used at left of upper-case bowl
rbowl=.7phh.slant-.5pu; % used at right of upper-case bowl
if pwiv>2pu: rstem=phh.slant+(ucs+usc-1.5)pu; % used at right of tall stem
else: rstem=phh.slant+(ucs+usc-2.5)pu+.5pwiv;
fi;
rv=phh.slant+(ucs+.75usc-1)pu; % used at right of tall diagonal
hic=1-.5mi; % used when half the italic correction goes into \\{rtcorr}
% From file ROMANU[MF,SYS]
"The letter A";
call charbegin(dc+`A,13,usc,usc,phh,0,0);
hpen; new w98,w99;
if pw>.5pwiv: w98=round(w0-3scorr); lft98x1=round((usc+.8ucs+.5)u-.5);
else: w98=w0; lft98x1=round 1.75u;
fi;
w99=round .5[w4,w5];
bot98y1=0; rt99x4=r-lft98x1; bot99y4=0;
x3-x1=x4-x2; rt99x2=rt98x3+del;
if pw>.5pwiv: cpen; new w95,w96;
w96=w26; w95=w25;
bot96y11=bot95y21=0; top96y3=hh;
y11=y31=y14=y34; y24=y21; y12=y2=y3=y13;
lft98x1=lft95x21; rt98x1=rt96x11; lft99x4=lft96x14; rt99x4=rt95x24;
lft98x3=lft96x13; rt99x2=rt96x12;
x20=round(w98/(w98+w99)[lft98x3,rt99x2]-.5); y20=hh-w18-3hcorr;
new aa; y1=aa[y31,y3];
x1=aa[x31,x3]; x4=aa[x34,x2];
call `g diag(21,13,31,3,95,96); % left half of left diagonal
call `h notch(31,11,96,3,20); % right half of left diagonal
call `i notch(34,14,96,2,20); % left half of right diagonal
call `j diag(24,12,34,2,95,96); % right half of right diagonal
if fixwidth[1,crisp]=0: x50=.5[x13,x12]; top96y50=round top6y13;
w96 ddraw 13{x3-x1,y3-y21}..50{1,0}..12{x4-x2,y24-y2},
13..3..12; % round off middle
fi;
y5=y6; top18y5=round e;
new aa,bb; % auxiliary variables for intersection of lines
x5=aa[x1,x3]; y5=aa[y1,y3];
x6=bb[x4,x2]; y6=bb[y4,y2];
w18 draw 5..6; % bar line
else: top98y3=top99y2=hh+o+oo;
w99 draw 2..4; w98 draw 2..3; % right diagonal stroke
y5=y6=e;
new aa,bb; % auxiliary variables for intersection of lines
x5=aa[x1,x3]; y5=aa[y1,y3];
x6=bb[x4,x2]; y6=bb[y4,y2];
cpen; w18 draw 5..6; % bar line
lpen#; w99 draw 3..5; % erase excess at upper left
hpen; w98 draw 3..1; % left diagonal stroke
fi;
if ucs≠0: new aa;
if rt98x1+ucs.u+.5u>lft99x4-ucs.u-2: rt98x1+aa.u+.5u=lft99x4-aa.u-2;
else: aa=ucs;
fi; % note: I should change all the similar routines to read like this!
% note that "a+w1>x3-x2-1" is equiv to "a+rt1x2>lft1x3-2"
call `a dserif(1,98,3,1/2,-.8ucs);
call `b dserif(1,98,3,.6,aa);
call `c bserif(1,98,-.8ucs,aa); % left serif
call `d serif(4,99,2,1/2,-aa);
call `e serif(4,99,2,1/3,+.8ucs);
call `f bserif(4,99,-aa,+.8ucs); % right serif
fi.
% From file ROMANU[MF,SYS]
"The letter B";
call charbegin(dc+`B,12.5,usc,-.5mc(.75phh.slant-.5pu),phh,0,
hic(.75phh.slant-.5pu));
new w80; w80=round(w4-2scorr);
new w85,delta;
if ucs=0: w85=round(w5-3scorr); delta=-.5u;
else: w85=w5; delta=0;
fi;
hpen; top80y1=hh; bot80y2=0;
if w80>2u: lft80x1=lft80x2=round 2u;
else: x1=x2=good80 3u;
fi;
w80 draw 1..2; % stem
x3=x5=1/2[1.5u,r]+delta; x13=x15=x18=x1; x6=x8=x3+1/2u;
vpen; top17y3=top6y1; y13=y3; bot17y18=bot6y2; y8=y18;
bot6y15=round .5hh; y5=y6=y15; x93=x3; y93=y13; x98=x8; y98=y18;
w17 draw 13..93; % upper bar line
w17 draw 18..98; % lower bar line
cpen; w6 draw 15..6; % middle bar line
new w99; w99=round(.6w6+.5);
x25=x5; x26=x6; top99y25=top6y5; bot99y26=bot6y6;
rt85x4=round(r-1.5u); rt85x7=round(r-u); y4=.5[y3,y5]; y7=.5[y6,y8];
call `g arc(0,3,17,delta,4,85); call `h arc(0,25,99,delta,4,85); % upper bowl
call `i arc(0,26,99,delta,7,85); call `j arc(0,8,17,delta,7,85); % lower bowl
if ucs≠0:
call `a serif(1,80,2,1/3,-ucs);
call `b serif(1,80,2,1/3,.5ucs);
call `c ubserif(1,80,-ucs,.5ucs); % upper serif
call `d serif(2,80,1,1/3,-ucs);
call `e serif(2,80,1,1/3,.5ucs);
call `f bserif(2,80,-ucs,.5ucs); % lower serif
fi.
% From file ROMANU[MF,SYS]
"The letter C";
if ucs=0: call charbegin(dc+`C,11.5,mc.lbowl,-.5mc(phh.slant-.5pu),
phh,0,hic(phh.slant-.5pu));
cpen; x3=x5=round .5(r+2.5u); bot19y5=-o;
new w99; w99=w19; top99y3=hh+o;
rt20x2=round(r-1.25u);
x31=x32=x3; top20y31=top99y3; bot20y32=bot99y3;
top20y1=round .95hh+o; y2=round(y1-9/7[w6,w3]+w20);
x1=x2;
w20 ddraw 1{x31-x1,2(y31-y1)}..31{-1,0},
2{x32-x2,2.5(y32-y2)}..32{-1,0}; % upper terminal
if w5>2u: lft5x4=round u;
else: x4=good5 2u;
fi;
y4=.5hh; call `a arc(0,3,99,0,4,5); % upper part of stroke
call `b arc(0,5,19,0,4,5); % lower part of stroke
new w93; w93=w3; %y30=good93 .125hh;
% top20y7=top93y30; bot20y6=bot93y30;
bot20y6=round .07hh-o; y7=y6+w93-w20;
rt20x7=round(r-u);
x6=good20(x7-(u/h)(y7-y6));
bot20y16=bot19y5; top20y17=top19y5; x16=x17=x5;
w20 ddraw 17{1,0}..7{x7-x17,2(y7-y17)},
16{1,0}..6{x6-x16,3(y6-y16)}; % lower terminal
else: call charbegin(dc+`C,13,mc.lbowl,-.5mc(phh.slant-.5pu),
phh,0,hic(phh.slant-.5pu));
cpen; rt20x1=round(r-u); x5=x1; x11=x15=x1-(w16-w20);
lft20x3=round u; x13=x3+w5-w20; x12=x14=.55[x13,x11];
top20y2=hh+o; y12=y2-(w22-w20); bot20y4=-o;
y14=y4+w22-w20; y3=y13=.5[y2,y4];
if m<.6hh: bot6y1=round 2/3hh;
else: y1=good6 m;
fi;
y11=y1; y5=y15=good6 .95(hh-y1);
new aa; y2=aa[y12,y1]; x2=aa[x12,x1];
new aa; y4=aa[y14,y5]; x4=aa[x14,x5];
x7=x1; top20y7=hh; lft20x8=x11-w5; y8=y1;
x6=x11; y6=.5[y1,y5];
w20 ddraw 1..7, 8..7; % upper serif
lpen#; w5+1 draw (6..)11..12{-1,0}; % erase spurious part
hpen; y88=y11; rt16x88=rt20x1; w16 draw 88;
cpen;
x0=1/sqrttwo[x2,x3]; x10=theta[1/sqrttwo[x12,x13],x0];
x9=1/sqrttwo[x4,x3]; x19=theta[1/sqrttwo[x14,x13],x9];
y0=1/sqrttwo[y3,y2]; y10=theta[1/sqrttwo[y13,y12],y0];
y9=1/sqrttwo[y3,y4]; y19=theta[1/sqrttwo[y13,y14],y9];
w20 ddraw (6..)1..2{-1,0}..0{x3-x2,y3-y2}..3{0,-1}..
9{x4-x3,y4-y3}..4{1,0}..5(..6),
(6..)11..12{-1,0}..10{x13-x12,y13-y12}..13{0,-1}..
19{x14-x13,y14-y13}..14{1,0}..15{0,1}(..6); % main stroke
hpen; y89=y15; rt16x89=rt20x5; w16 draw 89;
fi.
% From file AMR10.MF[MF,SYS]